home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue40 / Alfresco / AACvFrac.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1998-10-31  |  2.3 KB  |  86 lines
  1. {*********************************************************}
  2. {* AACvFrac                                              *}
  3. {* Copyright (c) Julian M Bucknall 1998                  *}
  4. {* All rights reserved.                                  *}
  5. {*********************************************************}
  6. {* Conversion of decimal to vulgar fractions             *}
  7. {*********************************************************}
  8.  
  9. {Note: this unit is released as freeware. In other words, you are free
  10.        to use this unit in your own applications, however I retain all
  11.        copyright to the code. JMB}
  12.  
  13. unit AACvFrac;
  14.  
  15. interface
  16.  
  17. const
  18.   MaxContFracDepth = 100;
  19.  
  20. const
  21.   CvtFracEpsilon : double = 0.0001;
  22.  
  23. procedure ConvertFraction(aValue       : double;
  24.                       var aNumerator   : longint;
  25.                       var aDenominator : longint);
  26.  
  27. implementation
  28.  
  29. procedure ConvertFraction(aValue       : double;
  30.                       var aNumerator   : longint;
  31.                       var aDenominator : longint);
  32. var
  33.   Sign : integer;
  34.   Iter : integer;
  35.   i    : integer;
  36.   Num  : double;
  37.   Denom: double;
  38.   Temp : double;
  39.   ContFrac : array [0..pred(MaxContFracDepth)] of integer;
  40. begin
  41.   {get the sign of the decimal fraction}
  42.   if aValue < 0.0 then begin
  43.     Sign := -1;
  44.     aValue := abs(aValue);
  45.   end
  46.   else
  47.     Sign := 1;
  48.   {create the continued fraction}
  49.   FillChar(ContFrac, sizeof(ContFrac), 0);
  50.   ContFrac[0] := Trunc(aValue);
  51.   Iter := 1;
  52.   aValue := Frac(aValue);
  53.   while (aValue >= CvtFracEpsilon) and
  54.         (Iter < MaxContFracDepth) do begin
  55.     aValue := 1.0 / aValue;
  56.     ContFrac[Iter] := Trunc(aValue);
  57.     inc(Iter);
  58.     aValue := Frac(aValue);
  59.   end;
  60.   dec(Iter);
  61.   {convert the continued fraction to a normal vulgar fraction}
  62.   if (Iter = 0) then begin
  63.     aNumerator := ContFrac[Iter];
  64.     aDenominator := 1;
  65.   end
  66.   else begin
  67.     Num := 1;
  68.     Denom := ContFrac[Iter];
  69.     for i := pred(Iter) downto 0 do begin
  70.       Temp := Denom * ContFrac[i] + Num;
  71.       Num := Denom;
  72.       Denom := Temp;
  73.     end;
  74.     if (Denom > MaxLongint) or (Num > MaxLongint) then begin
  75.       aNumerator := -1;
  76.       aDenominator := -1;
  77.     end
  78.     else begin
  79.       aNumerator := Sign * Trunc(Denom);
  80.       aDenominator := Trunc(Num);
  81.     end;
  82.   end;
  83. end;
  84.  
  85. end.
  86.